home *** CD-ROM | disk | FTP | other *** search
/ Over 1,000 Windows 95 Programs / Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso / 1256 / tour010.co_ / tour010.co
Text File  |  1997-04-18  |  12KB  |  305 lines
  1.       *---Created with EasyCODE(COB)----------------------------------- # EASY O
  2.       *---Last modification: 01.03.1995 14:23:36----------------------- # EASY K
  3.       *This program is used to collect data of journeys.
  4.       *---------------------------------------------------------------- # EASY *
  5.       *---------------------------------------------------------------- # EASY (
  6.       *TOUR010
  7.       *---------------------------------------------------------------- # EASY *
  8.        IDENTIFICATION DIVISION.
  9.       *---------------------------------------------------------------- # EASY (
  10.       **** Identification Division ***
  11.       *---------------------------------------------------------------- # EASY *
  12.        PROGRAM-ID. TOUR010.
  13.       *
  14.       *
  15.       *      THIS PROGRAM IS USED TO COLLECT THE DATA OF JOURNEYS.
  16.       *      IT IS DESIGNED TO BE ACTIVATED
  17.       *
  18.       *      1.) FROM THE MENU USING A MESSAGE OF THE LENGTH 0
  19.       *      2.) BY A LINE MESSAGE OF THE LENGTH 0
  20.       *      OR 4 (THIS WILL BE THE ID OF THE JOURNEY
  21.       *      FOR WHICH INFORMATION IS TO BE COLLECTED)
  22.       *      AND
  23.       *      3.) BY ITSELF.
  24.       *
  25.       *      ITS TACS :   COLLECT (FOR 1ST AND 3RD),
  26.       *           NEW       (FOR 2ND)
  27.       *
  28.       *
  29.       *---------------------------------------------------------------- # EASY )
  30.        ENVIRONMENT DIVISION.
  31.        DATA DIVISION.
  32.       *---------------------------------------------------------------- # EASY (
  33.       **** Data Division ***
  34.       *---------------------------------------------------------------- # EASY *
  35.       *---------------------------------------------------------------- # EASY (
  36.       **** WORKING-STORAGE Section ***
  37.       *---------------------------------------------------------------- # EASY *
  38.        WORKING-STORAGE SECTION.
  39.        77 ENTER-KEY            PIC X(3)  VALUE "000".
  40.        77 F1-KEY            PIC X(3)  VALUE "21Z".
  41.        77 K1-KEY            PIC X(3)  VALUE "24Z".
  42.        77 K2-KEY            PIC X(3)  VALUE "25Z".
  43.       
  44.        77 ERRORMESSAGE-1       PIC X(80) VALUE
  45.        "WRONG INPUT DATA - PLEASE RETRY".
  46.        77 ERRORMESSAGE-2       PIC X(80) VALUE
  47.        "JOURNEY'S ID ALREADY EXISTS - PLEASE USE DIFFERENT ID".
  48.        77 ERRORMESSAGE-3       PIC X(80) VALUE
  49.        "WRONG KEY - ONLY ENTER OR K1 ALLOWED".
  50.        77 RESULTMESSAGE        PIC X(80) VALUE
  51.        "JOURNEY'S DATA WRITTEN TO FILE".
  52.       
  53.        COPY KCOPC.
  54.        COPY KCDFC.
  55.       *                                 # EASY S
  56.       *---------------------------------------------------------------- # EASY )
  57.       *---------------------------------------------------------------- # EASY (
  58.       **** LINKAGE Section ***
  59.       *---------------------------------------------------------------- # EASY *
  60.        LINKAGE SECTION.
  61.      COPY KCKBC.
  62.         05 MENU-MESSAGE   PIC X(80).
  63.       
  64.         05 NB          PIC X(108).
  65.         05 COLLECT          REDEFINES NB.
  66.           COPY COLLECT.
  67.       
  68.      COPY KCPAC.
  69.         03 ERROR-LINE.
  70.            05 RET-CODE    PIC X(3).
  71.            05 OCCURRED-AT PIC X(5).
  72.            05 OP-CODE     PIC X(4).
  73.            05 FILLER      PIC X(96).
  74.       
  75.       
  76.         03 JOURNEY.
  77.            COPY JOURNEY.
  78.       
  79.         03 PEND-MODE      PIC X(2).
  80.         03 NEXT-TAC       PIC X(8).
  81.         03 ERROR-SIGN       PIC 9.
  82.       *                                 # EASY S
  83.       *---------------------------------------------------------------- # EASY )
  84.       *---------------------------------------------------------------- # EASY )
  85.        PROCEDURE DIVISION USING KCKBC KCSPAB.
  86.       *---------------------------------------------------------------- # EASY (
  87.       **** Procedure Division ***
  88.       *---------------------------------------------------------------- # EASY *
  89.       *---------------------------------------------------------------- # EASY (
  90.       **** INIT-OPERATION ***
  91.       *---------------------------------------------------------------- # EASY *
  92.        INIT-OPERATION.
  93.        MOVE INIT TO KCOP
  94.       *                                 # EASY -
  95.        MOVE 80 TO KCLKBPRG
  96.       *                                 # EASY -
  97.        MOVE 1000 TO KCLPAB
  98.        CALL "KDCS" USING KCPAC
  99.        IF KCRCCC NOT = "000"
  100.        THEN
  101.           PERFORM ERROR-MPUT-OPERATION
  102.           PERFORM ERROR-PEND-OPERATION
  103.        END-IF
  104.        .
  105.       *                                 # EASY P
  106.       *---------------------------------------------------------------- # EASY )
  107.       *---------------------------------------------------------------- # EASY (
  108.       **** MGET-OPERATION ***
  109.       *---------------------------------------------------------------- # EASY *
  110.        MGET-OPERATION.
  111.        MOVE MGET TO KCOP
  112.       *                                 # EASY -
  113.        MOVE 108 TO KCLA
  114.       *                                 # EASY -
  115.        MOVE "*COLLECT" TO KCMF
  116.        CALL "KDCS" USING KCPAC, COLLECT
  117.        .
  118.       *                                 # EASY P
  119.       *---------------------------------------------------------------- # EASY )
  120.       *---------------------------------------------------------------- # EASY (
  121.       **** PROCESSING ***
  122.       *---------------------------------------------------------------- # EASY *
  123.        PROCESSING.
  124.        EVALUATE KCRCCC
  125.        WHEN "05Z"
  126.           PERFORM START-COLLECTING
  127.        WHEN K1-TASTE
  128.           PERFORM FINISH-COLLECTING
  129.        WHEN DUE-TASTE
  130.           PERFORM CONTINUE-COLLECTING
  131.        WHEN OTHER
  132.           IF
  133.           KCRCCC NOT < F1-KEY AND
  134.           KCRCCC NOT > K2-KEY
  135.           THEN
  136.          PERFORM REJECT-WRONG-KEY
  137.           ELSE
  138.          PERFORM ERROR-MPUT-OPERATION,
  139.          PERFORM ERROR-PEND-OPERATION
  140.           END-IF
  141.        END-EVALUATE
  142.        .
  143.       *                                 # EASY P
  144.       *---------------------------------------------------------------- # EASY )
  145.       *---------------------------------------------------------------- # EASY (
  146.       **** MPUT-OPERATION ***
  147.       *---------------------------------------------------------------- # EASY *
  148.        MPUT-OPERATION.
  149.        MOVE MPUT TO KCOP
  150.       *                                 # EASY -
  151.        MOVE "NE" TO KCOM
  152.        CALL "KDCS" USING KCPAC, COLLECT
  153.        IF KCRCCC > "000"
  154.        THEN
  155.           PERFORM ERROR-PEND-OPERATION
  156.        END-IF
  157.        .
  158.       *                                 # EASY P
  159.       *---------------------------------------------------------------- # EASY )
  160.       *---------------------------------------------------------------- # EASY (
  161.       **** PEND-OPERATION ***
  162.       *---------------------------------------------------------------- # EASY *
  163.        PEND-OPERATION.
  164.        MOVE PEND TO KCOP
  165.       *                                 # EASY -
  166.        MOVE PEND-MODE TO KCOM
  167.       *                                 # EASY -
  168.        MOVE NEXT-TAC TO KCRN
  169.        CALL "KDCS" USING KCPAC
  170.        .
  171.       *                                 # EASY P
  172.       *---------------------------------------------------------------- # EASY )
  173.       *---------------------------------------------------------------- # EASY (
  174.       **** ERROR-PEND-OPERATION ***
  175.       *---------------------------------------------------------------- # EASY *
  176.        ERROR-PEND-OPERATION.
  177.        MOVE PEND TO KCOP
  178.       *                                 # EASY -
  179.        MOVE "ER" TO KCOM
  180.        CALL "KDCS" USING KCPAC
  181.        .
  182.       *                                 # EASY P
  183.       *---------------------------------------------------------------- # EASY )
  184.       *---------------------------------------------------------------- # EASY (
  185.       **** ERROR-MPUT-OPERATION ***
  186.       *---------------------------------------------------------------- # EASY *
  187.        ERROR-MPUT-OPERATION.
  188.        MOVE SPACES TO ERROR-LINE
  189.       *                                 # EASY -
  190.        MOVE KCRCCC TO RET-CODE
  191.       *                                 # EASY -
  192.        MOVE " AT " TO OCCURRED-AT
  193.       *                                 # EASY -
  194.        MOVE KCOP TO OP-CODE
  195.       *                                 # EASY -
  196.        MOVE MPUT TO KCOP
  197.       *                                 # EASY -
  198.        MOVE "NE" TO KCOM,
  199.        MOVE 12 TO KCLM
  200.       *                                 # EASY -
  201.        MOVE SPACES TO KCMF, KCRN
  202.       *                                 # EASY -
  203.        MOVE KCALARM TO KCDF
  204.        CALL "KDCS" USING KCPAC, ERROR-LINE
  205.        .
  206.       *                                 # EASY P
  207.       *---------------------------------------------------------------- # EASY )
  208.       *---------------------------------------------------------------- # EASY (
  209.       **** END-OF-PROGRAM ***
  210.       *---------------------------------------------------------------- # EASY *
  211.        END-OF-PROGRAM.
  212.        EXIT PROGRAM
  213.        .
  214.       *                                 # EASY P
  215.       *---------------------------------------------------------------- # EASY )
  216.       *---------------------------------------------------------------- # EASY (
  217.       **** START-COLLECTING ***
  218.       *---------------------------------------------------------------- # EASY *
  219.        START-COLLECTING.
  220.        IF KCRLM NOT = 4
  221.        THEN
  222.           MOVE ZEROES TO JOURNEY-ID OF COLLECT
  223.        END-IF
  224.        MOVE SPACES TO WHERETOGO OF COLLECT,
  225.        NOTICE OF COLLECT
  226.       *                                 # EASY -
  227.        MOVE ZEROES TO FREE-SEATS OF COLLECT
  228.        PERFORM PREPARE-OUTPUT
  229.        .
  230.       *                                 # EASY P
  231.       *---------------------------------------------------------------- # EASY )
  232.       *---------------------------------------------------------------- # EASY (
  233.       **** FINISH-COLLECTING ***
  234.       *---------------------------------------------------------------- # EASY *
  235.        FINISH-COLLECTING.
  236.        MOVE SPACES TO MENU-MESSAGE
  237.       *                                 # EASY -
  238.        MOVE "MENUOUT" TO KCRN, NEXT-TAC
  239.       *                                 # EASY -
  240.        MOVE 0 TO KCLM
  241.       *                                 # EASY -
  242.        MOVE "PR" TO PEND-MODE
  243.        .
  244.       *                                 # EASY P
  245.       *---------------------------------------------------------------- # EASY )
  246.       *---------------------------------------------------------------- # EASY (
  247.       **** CONTINUE-COLLECTING ***
  248.       *---------------------------------------------------------------- # EASY *
  249.        CONTINUE-COLLECTING.
  250.        IF
  251.        JOURNEY-ID OF COLLECT NOT NUMERIC         OR
  252.        JOURNEY-ID OF COLLECT = ZERO          OR
  253.        WHERETOGO OF COLLECT = SPACES         OR
  254.        FREE-SEATS OF COLLECT NOT NUMERIC         OR
  255.        FREE-SEATS OF COLLECT = ZERO
  256.        THEN
  257.           MOVE ERRORMESSAGE-1 TO NOTICE OF COLLECT
  258.        ELSE
  259.           MOVE CORRESPONDING COLLECT TO MASK OF JOURNEY,
  260.           MOVE ZERO TO BOOKED-SEATS OF JOURNEY,
  261.           CALL "WRJOURNEY"
  262.           USING
  263.           JOURNEY, ERROR-SIGN,
  264.           IF ERROR-SIGN = ZERO
  265.           THEN
  266.          MOVE RESULTMESSAGE TO NOTICE OF COLLECT
  267.           ELSE
  268.          MOVE ERRORMESSAGE-2 TO NOTICE OF COLLECT
  269.           END-IF
  270.        END-IF
  271.        PERFORM PREPARE-OUTPUT
  272.        .
  273.       *                                 # EASY P
  274.       *---------------------------------------------------------------- # EASY )
  275.       *---------------------------------------------------------------- # EASY (
  276.       **** REJECT-WRONG-KEY ***
  277.       *---------------------------------------------------------------- # EASY *
  278.        REJECT-WRONG-KEY.
  279.        MOVE ERRORMESSAGE-3 TO NOTICE OF COLLECT
  280.        PERFORM PREPARE-OUTPUT
  281.        .
  282.       *                                 # EASY P
  283.       *---------------------------------------------------------------- # EASY )
  284.       *---------------------------------------------------------------- # EASY (
  285.       **** PREPARE-OUTPUT ***
  286.       *---------------------------------------------------------------- # EASY *
  287.        PREPARE-OUTPUT.
  288.        MOVE 108 TO KCLM
  289.       *                                 # EASY -
  290.        MOVE "*COLLECT" TO KCMF
  291.       *                                 # EASY -
  292.        MOVE SPACES TO KCRN
  293.       *                                 # EASY -
  294.        MOVE "COLLECT" TO NEXT-TAC
  295.       *                                 # EASY -
  296.        MOVE "RE" TO PEND-MODE
  297.       *                                 # EASY -
  298.        MOVE ZERO TO KCDF
  299.        .
  300.       *                                 # EASY P
  301.       *---------------------------------------------------------------- # EASY )
  302.       *---------------------------------------------------------------- # EASY )
  303.        END PROGRAM TOUR010.
  304.       *---------------------------------------------------------------- # EASY )
  305.